#'###########################################
#'                                          #
#'  ------------------------------------    #
#'  |     COIN     __                  |    #
#'  |            >(' )                 |    #
#'  |              )/                  |    #
#'  |             /  `----/            |    #
#'  |             \  ~=- /             |    #
#'  |   ~^~^~^~^~^~^~^~^~^~^~^~^~^~^   |    #
#'  ------------------------------------    #
#'                                          #
#'###########################################



#' Fonctions pour ajouter les intervalles de confiance
prepanel.errorbar <- function(x, y, ly, uy, groups, subscripts, ylimits=NULL, y.padding.bottom=0.03, y.padding.top=0.1,...)
{
	if (!is.null(ylimits)){
		return (list(ylim = ylimits))
	}
  y <- as.numeric(y)
  ly <- as.numeric(ly[subscripts])
  uy <- as.numeric(uy[subscripts])
  ymax <- max(y, uy, ly, na.rm=TRUE)
  return (list(ylim = c(0 - ymax * y.padding.bottom, ymax * (1+ y.padding.top))))
}

panel.errorbar <- function(x, y, ly, uy, addN=FALSE, addText=FALSE, textFUN = NULL, groups, subscripts, box.ratio, 
    axis.right=FALSE, draw.yaxis=TRUE, ...)
{	
	if (missing(groups)) {
		groups <- NULL
	}
  x <- as.numeric(x)
  y <- as.numeric(y)
  ly <- as.numeric(ly[subscripts])
	ly[ly < 0] <- 0
  uy <- as.numeric(uy[subscripts])

  #' Trace du graphique
 	panel.barchart(x, y, subscripts=subscripts,
      groups=groups, cex = 1, box.ratio=box.ratio, ...)
	#' Intervalle de confiance
	if(!is.null(groups)) {
	  d <- 1 / (nlevels(groups) + nlevels(groups) / box.ratio)
	  g <- (as.numeric(groups[subscripts]) - 1)
	  g <- (g - median(g)) * d
	} else {
		g <- 0
	}
  panel.arrows(x + g, ly, x + g, uy,
      code=3, angle=90, length=0.025)
  
  if (addN) {
    addNToBarchart(x + g, uy, ...)
  }
  
	if (addText){
		textFUN(x, y, ...)
	}
  
  lims <- current.panel.limits()
  xscale <- convertX(unit(0:1, "npc"), "native", valueOnly=TRUE)
  yscale <- convertY(unit(0:1, "npc"), "native", valueOnly=TRUE)
  pushViewport(viewport(clip="off",
          xscale=xscale, yscale=yscale))
  if (draw.yaxis) {
    if (axis.right) {
        grid.lines(c(lims$xlim[2], lims$xlim[2]), c(lims$ylim[1], lims$ylim[2]),
            default.units="native")
    } else {
        grid.lines(c(lims$xlim[1], lims$xlim[1]), c(lims$ylim[1], lims$ylim[2]),
            default.units="native")
    }
  }
  grid.lines(c(lims$xlim[1], lims$xlim[2]), c(0, 0),
      default.units="native")
  popViewport()
  
}


addNToBarchart <- function (x, y, ...) {
  args <- list(...)
  text <- args$nText
  offset <- args$nOffset
  str(offset)
  y <- y + offset
  str(y)
  print(text)
  panel.text(x, y, text)
}

panel.text.addNlocs <- function (x, y, ...){
	#' Recuperation des arguments
	args <- list(...)
	spacing <- args$spacing
	textlabels <- args$textlabels
	textadj <- args$textadj
	textcex <- ifelse(is.null(args$textcex), 1.0, args$textcex)
	propy <- ifelse(is.null(args$propy), 1.0, args$propy)
	offx <- ifelse(is.null(args$offx), 0, args$offx)
  text.x <- ifelse(is.null(args$text.x),  max(x), args$text.x)
  text.y <-  ifelse(is.null(args$text.y), max(y), args$text.y) 
	
	xtmp <- text.x + offx
	ystart <- text.y
	coef <- seq(propy + length(textlabels) * spacing, propy, by=-spacing)
	
	for (i in seq(along.with=textlabels)) {
	  ytmp <- ystart * coef[i]
	  panel.text(xtmp, ytmp , textlabels[i], adj=textadj,	cex=textcex)
	}
}

panel.text.title <- function (x, y, ...){
    #' Recuperation des arguments
    args <- list(...)
    
    lims <- current.panel.limits()
    
    text.title <- args$text.title
    text.adj.title <- ifelse(is.null(args$text.adj), c(0, 1), args$text.adj)
    text.cex.title <- ifelse(is.null(args$text.cex), 1.0, args$text.cex)
    text.x.title <- lims$xlim[2] * ifelse(is.null(args$text.x), 0.25, args$text.x)
    text.y.title <-  lims$ylim[2] * ifelse(is.null(args$text.y), 0.96, args$text.y)
    fontface.title <- ifelse(is.null(args$text.fontface), "bold", args$text.fontface)
    
    panel.text(text.x.title, text.y.title, text.title, adj=text.adj.title,	cex=text.cex.title,
        fontface=fontface.title, unit="native")
    
    if (!is.null(args$text.letter)){
        text.letter <- args$text.letter
        text.x.letter <- lims$xlim[2]* ifelse(is.null(args$text.x), 0.1, args$text.x)
        text.y.letter <-  lims$ylim[2] * ifelse(is.null(args$text.y), 0.98, args$text.y)
        
        panel.text(text.x.letter, text.y.letter, text.letter,
            adj=text.adj.title,	cex=text.cex.title, fontface=fontface.title,
            unit="native")
    }
}

error.bar <- function(x, y, upper, lower=upper, length=0.1,...){
  if(length(x) != length(y) | length(y) !=length(lower) | length(lower) != length(upper))
    stop("vectors must be same length")
  arrows(x,y+upper, x, y-lower, angle=90, code=3, length=length, ...)
}


save.png <- function(graph, path, width=700, height=700) {
	png(file=path, width=width, height=height)
	print(graph)
	dev.off()
}


#'#
#'# Proportion de localisations pour chaque visibilite
#'# 

static.barchart <- function(data, col, main,
				ylimits=NULL,
				xlab="Classes de localisation",
				ylab="Proportion moyenne de localisations (% \261 IC 95%)",
				key=list(text=list(c("Ciel visible 66-100%",
								"                    33-66%",
								"                    0-33%")), 
					rectangles=list(col=col), x=1, y=0.98, corner=c(1, 1)),
				box.ratio=3,
				origin=0) {
	graph <- barchart(mean ~ LC, data, 
			groups=as.factor(visibility),
			stack=FALSE,
			ly=data[, lb],
			uy=data[, ub],
			ylimits=ylimits,
			prepanel=prepanel.errorbar,
			panel=panel.errorbar,
			col=col,
			box.ratio=box.ratio,
			origin=origin,
			key=key,
			xlab=xlab,
			ylab=ylab,
			scales = list(col=1,tck=c(1,0)),
			main=list(label=main, fontsize=12)
	)
	return (graph)
}

print.multi <- function(graphs, nrow=1, ncol=1, hfill=TRUE, save=FALSE,
    save.dest=NULL, width=700, height=700, widthPad=0,
    heightPad=0, res=72, units="px", bitmap=FALSE, multiFUN=NULL, ...) {
	if (nrow == 1 && hfill) {
		ncol <- length(graphs)
	} else if (ncol == 1 && !hfill){
		nrow <- length(graphs)
	}
	currentRow <- 1
	currentCol <- 1
	maxRow <- nrow
	maxCol <- ncol
	more <- TRUE
	if(save) {
      if (bitmap) {
          bitmap(file=save.dest,
              units=units, res=res, height=height, width=width, type="tiff24nc",
              pointsize=12, family="Arial")
          
      } else {
  		    png(file=save.dest, width=width*ncol + widthPad,
              height=height*nrow + heightPad,
              units=units, res=res)
    }
	}
	for (i in 1:length(graphs)) {
		if (i == length(graphs)) {
			more=FALSE
		}
      
    print(graphs[[i]], split=c(currentCol, currentRow, maxCol, maxRow), more=more)
		
		if (hfill) {
			currentCol <- currentCol + 1
			if (currentCol > maxCol) {
				currentRow <- currentRow + 1
				currentCol <- 1
			}
		} else {
			currentRow <- currentRow + 1
			if (currentRow > maxRow) {
				currentCol <- currentCol + 1
				currentRow <- 1
			}
		}
	}
	if(save) {
		dev.off()
	}
}

printHRGraphs <- function (graphs, sepPos=.68, xMax=.98) {
    print(graphs[[1]], position=c(0, 0, sepPos, 1), more=T)
    print(graphs[[2]], position=c(sepPos, 0, xMax, 1), more=F)
    
    grid::seekViewport("plot_01.position.vp")
    grid::grid.lines(c(0.99, 0.99), c(0.08, 0.95), gp=gpar(lty=2))
} 

plotTracks <- function(data) {
    plot(data$ref@coords, col="blue")
    points(data$compared@coords, col="red")
}





static.map <- function (data, visibility, vsess, ptt, title, colours, labels, shapes, lim=1000) {
    vis <- data[[visibility]]
    argos <- vis@argos
    gps <- vis@gps
    setkeyv(argos, c("session", "id", "LC"))
    setkeyv(gps, c("session"))
    
    sa <- argos[list(vsess, ptt)]
    sg <- gps[list(vsess)]
    
    LCcol <- colours$argos[names(colours$argos) %in% unique(sa$LC)]
    LClab <- labels$argos[names(labels$argos) %in% unique(sa$LC)]
    cols <- c(LCcol, "gps"=colours$GPS)
    labs <- c(LClab, "gps"=labels$GPS)
    shaps <- c(rep(shapes$argos, length(LCcol)), shapes$GPS)
    names(shaps) <- c(names(LCcol), "gps")
    
    
    xcenter <- mean(sg$longitude)
    ycenter <- mean(sg$latitude)
    
    xlim <- c(xcenter - lim, xcenter + lim)
    ylim <- c(ycenter - lim, ycenter + lim)
    
    inc <- sa[, round(sum(argLong > xlim[1] & argLong < xlim[2] & argLat > ylim[1] & argLat < ylim[2])/.N * 100,1)]
    
    
    map <- ggplot(data=sa , aes(x=argLong, y=argLat)) + geom_point() + xlim(xlim) + ylim(ylim) +
        xlab("Longitude")+ ylab("Latitude") + aes(colour=LC, shape=LC) + ggtitle(paste(title, " (", inc, "%)", sep=""))
    
    map <- map + geom_point(data=sg, 
        aes(x=longitude, y=latitude, colour="gps", shape="gps"))
    
    map <- map + scale_colour_manual(name="", values=cols, 
        labels = labs,
        breaks=c(names(LClab), "gps"))
    map <- map + scale_shape_manual(name="", labels = labs, values=shaps, breaks=c(names(LClab), "gps"))
    
    
    map <- map + theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"), legend.key = element_blank())
    
    return(map)
}

mobile.map <- function (data, deployement, ptt, title, colours, labels, shapes, lim=1000) {
    track <- data[[deployement]]
    argos <- track@argos
    gps <- track@gps
    setkeyv(argos, c("id", "time"))
    
    argos <- argos[, LC := as.character(LC)]
    
    ma <- argos[list(ptt)]
    
    str(ma)
    str(gps)
    
    LCcol <- colours$argos[names(colours$argos) %in% unique(ma$LC)]
    LClab <- labels$argos[names(labels$argos) %in% unique(ma$LC)]
    cols <- c(LCcol, "gps"=colours$GPS)
    labs <- c(LClab, "gps"=labels$GPS)
    
    
    map <- ggplot(data=ma , aes(x=argLong, y=argLat)) + geom_path(data=gps, aes(x=longitude, y=latitude), size=1, colour=colours$GPS) +
        xlab("Longitude")+ ylab("Latitude") + ggtitle(title)
    
    map <- map + geom_point(data=head(gps, 1), aes(x=longitude, y=latitude, shape="gs"), colour="black", size=4) +
        geom_point(data=tail(gps, 1), aes(x=longitude, y=latitude, shape="ge"), colour="black", size=4)         
    
    
    map <- map + geom_path(colour="darkgrey")
    
    
    map <- map + geom_point(aes(colour=LC))
    start <- head(ma, 1)
    end <- tail(ma, 1)    
    map <- map + geom_point(data=start, aes(shape="as"), size=4) +
        geom_point(data=end, aes(shape="ae"), size=4)
    
    
    map <- map + scale_colour_manual(name="Location Classes", values=cols, 
        labels = labs, breaks=c(names(LClab), "gps"))
    #map <- map + scale_shape_manual(name="", labels = labs, values=shaps, breaks=c(names(LClab), "gps"))
    
           
    map <- map + scale_shape_manual(name="Trajectories", 
        labels = c("gs"="GPS start", "ge"="GPS end", "as"="Argos start", "ae"="Argos end"),
        breaks = c("gs", "ge", "as", "ae"),
        values=c("gs"=3, "ge"=4, "as"=1, "ae"=2))
             
    map <- map + theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"), legend.key = element_blank())
    
    map <- map + guides(shape = guide_legend(order=1),
        color = guide_legend(order=2))
    
    return(map)
}
